(* Creme Caramel Compiler (Triple C) - Michele Caceffo - 2008 *)

open Exceptions;;
open Syntaxtree;;
open Declaration;;
open Intermediate;;

(** Contains all the functions to perform a small semantic analisys, which means only type checking :) 
    To do this has been introduced the "Semantic Type" which simplify the check
*)

(** Recovers the semantic type from an offset 
    @param t The element from which recover the type
    @return The semantic type of t
*)
let rec getType (t: element): sType = match t with
          Off(off, tp, _)    ->  tp
        | Reg(reg, tp)       ->  tp
        | _                  ->  raise (TYPE_ERROR "Tipo non definito")

(** Checks the Semantic types of the arithmetical expressions
    @param ex The arithmetical expression to check
    @param The declarations table
    @param The procedures table
    @return The semantic type of ex
*)
let rec checkAexp (ex: aexp) (dect: dec_table) (proct: proc_table) :sType = match ex with
          N(_)          ->  DInt
        | R(_)          ->  DFloat
        | Var(i)        ->  let (_,_,t) = (getVarDeclaration i dect) in (getType t)
        | Vec(i,x)      ->  if ((checkAexp x dect proct) = DInt) then (
                                let (_,_,t) = (getVarDeclaration i dect) in (getType t)
                            ) else (
                                raise (SEMANTIC_ERROR "Invalid Index")
                            )
        | Mat(i,x,y)    ->  if (((checkAexp x dect proct) = DInt) & ((checkAexp y dect proct) = DInt)) then (
                                let (_,_,t) = (getVarDeclaration i dect) in (getType t)
                            ) else (
                                raise (SEMANTIC_ERROR "Invalid Index")
                            )
        (** For now are only allowed arithmetical operations between int and int or float and float, not mixed operations*)
        | Sum(ex1,ex2)  ->  (
                             let t1 = (checkAexp ex1 dect proct) and
                             t2 = (checkAexp ex2 dect proct) in
                             match (t1,t2) with
                                (DInt, DInt)        ->  DInt
                              | (DFloat, DFloat)    ->  DFloat
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )
        | Sub(ex1,ex2)  ->  (
                             let t1 = (checkAexp ex1 dect proct) and
                             t2 = (checkAexp ex2 dect proct) in
                             match (t1,t2) with
                                (DInt, DInt)        ->  DInt
                              | (DFloat, DFloat)    ->  DFloat
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )
        | Mul(ex1,ex2)  ->  (
                             let t1 = (checkAexp ex1 dect proct) and
                             t2 = (checkAexp ex2 dect proct) in
                             match (t1,t2) with
                                (DInt, DInt)        ->  DInt
                              | (DFloat, DFloat)    ->  DFloat
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )
        | Div(ex1,ex2)  ->  (
                             let t1 = (checkAexp ex1 dect proct) and
                             t2 = (checkAexp ex2 dect proct) in
                             match (t1,t2) with
                                (DInt, DInt)        ->  DInt
                              | (DFloat, DFloat)    ->  DFloat
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )
        | FCall(i,el)   ->  (
                             let pten = (Hashtbl.find proct i) in match pten with
                                Building(t, plist)              ->  (
                                                                     if (checkParTypes (List.rev plist) (List.rev el) dect proct)
                                                                     then (
                                                                         match t with
                                                                             SRet(Int)   -> DInt
                                                                           | SRet(Float) -> DFloat
                                                                           | Void        -> raise (SEMANTIC_ERROR "Void function")
                                                                     )
                                                                     else raise (SEMANTIC_ERROR "Different Parameters Types")
                                                                    )
                              | Subroutine(t,plist,_,_)   ->  (
                                                                     if (checkParTypes (List.rev plist) (List.rev el) dect proct)
                                                                     then (
                                                                         match t with
                                                                             SRet(Int)   -> DInt
                                                                           | SRet(Float) -> DFloat
                                                                           | Void        -> raise (SEMANTIC_ERROR "Void function")
                                                                     )
                                                                     else raise (SEMANTIC_ERROR "Different Parameters Types")
                                                                    )
                            )
(** Checks the semantic type of a list of parameters
    @param plist The list of formal parameters
    @param el The list of actual parameters
    @param dect The declarations table
    @param proct The procedures table
    @return True if the formal parameters types match with the actual parameters type, False otherwise
*)
and checkParTypes (plist: dec list) (el: aexp list) (dect: dec_table) (proct: proc_table) = match (plist,el) with
          ([],[])               ->  true
        | ([x],[])              ->  true
        | (Dec(id,Basic(t))::ps,e::es)  ->  (
                                     match t with
                                         Int    ->  ((checkAexp e dect proct) = DInt) & checkParTypes ps es dect proct
                                       | Float  ->  ((checkAexp e dect proct) = DFloat) & checkParTypes ps es dect proct
                                    )
        | _                     ->  raise (SEMANTIC_ERROR "Wrong Parameters Number")

(** Checks the semantic type of boolean operations (compare is only allowed betrween int and int or float and float, 
    not mixed operations)
    @param b The boolean operation to check
    @param dect The declarations table
    @param proct The procedures table
    @return The sematic type of b
*)
and checkBool (b: bexp) (dect: dec_table) (proct: proc_table) = match b with
          B(b)          ->  DBool
        | Equ(ex1,ex2)  ->  (
                             let t1 = (checkAexp ex1 dect proct) and
                             t2 = (checkAexp ex2 dect proct) in
                             match (t1,t2) with
                                (DInt, DInt)        ->  DBool
                              | (DFloat, DFloat)    ->  DBool
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )
        | LE(ex1,ex2)   ->  (
                             let t1 = (checkAexp ex1 dect proct) and
                             t2 = (checkAexp ex2 dect proct) in
                             match (t1,t2) with
                                (DInt, DInt)        ->  DBool
                              | (DFloat, DFloat)    ->  DBool
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )
        | LT(ex1,ex2)   ->  (
                             let t1 = (checkAexp ex1 dect proct) and
                             t2 = (checkAexp ex2 dect proct) in
                             match (t1,t2) with
                                (DInt, DInt)        ->  DBool
                              | (DFloat, DFloat)    ->  DBool
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )
        | Not(bx)       ->  if ((checkBool bx dect proct) = DBool) then DBool else raise (SEMANTIC_ERROR "Different Types")
        | And(bx1,bx2)  ->  (
                             let t1 = (checkBool bx1 dect proct) and
                             t2 = (checkBool bx2 dect proct) in
                             match (t1,t2) with
                                (DBool, DBool)      ->  DBool
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )
        | Or(bx1,bx2)   ->  (
                             let t1 = (checkBool bx1 dect proct) and
                             t2 = (checkBool bx2 dect proct) in
                             match (t1,t2) with
                                (DBool, DBool)      ->  DBool
                              | _                   ->  raise (SEMANTIC_ERROR "Different Types")
                            )

(** Checks the semantic type of left expression
    @param l The left expression to check
    @param dect The declarations table
    @return The semantic type of l
*)
let checkLexp (l: lexp) (dect: dec_table) proct = match l with
          LVar(i)       ->  let (_,_,t) = (getVarDeclaration i dect) in (getType t)
        | LVecModify(i,x)     ->  if ((checkAexp x dect proct) = DInt) then (
                                let (_,_,t) = (getVarDeclaration i dect) in (getType t)
                            ) else (
                                raise (SEMANTIC_ERROR "Invalid Index")
                            )
        | LMat(i,x,y)    ->  if (((checkAexp x dect proct) = DInt) & ((checkAexp y dect proct) = DInt)) then (
                                let (_,_,t) = (getVarDeclaration i dect) in (getType t)
                            ) else (
                                raise (SEMANTIC_ERROR "Invalid Index")
                            )
(** Checks the semantic type of commands
    @param c The command to check
    @param dect The declarations table
    @return True of the command is well formed (type checking is good), Flase otherwise
*)
let rec cmdsemantic (c: cmd) (dect: dec_table) proct = match c with
          Ass(l,r)      ->  (checkLexp l dect proct) = (checkAexp r dect proct)
        | Blk(cl)       ->  (
                             match cl with
                                []      ->  true
                              | x::xs   ->  (cmdsemantic x dect proct) & (cmdsemantic (Blk(xs)) dect proct)
                            )
        | Ite(b,c1,c2)  ->  ((checkBool b dect proct) = DBool) & (cmdsemantic c1 dect proct) & (cmdsemantic c2 dect proct)
        | While(b,c)    ->  ((checkBool b dect proct) = DBool) & (cmdsemantic c dect proct)
        | Write(e)      ->  true
        | PCall(i,pl)   ->  (
                             let pten = (Hashtbl.find proct i) in match pten with
                                Building(t, plist)              ->  (
                                                                     if (checkParTypes (List.rev plist) (List.rev pl) dect proct)
                                                                     then true
                                                                     else raise (SEMANTIC_ERROR "Different Parameters Types")
                                                                    )
                              | Subroutine(t,plist,ldtable,_)   ->  (
                                                                     if (checkParTypes (List.rev plist) (List.rev pl) dect proct)
                                                                     then true
                                                                     else raise (SEMANTIC_ERROR "Different Parameters Types")
                                                                    )
                            )
